home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 2 / LSD and 17bit Compendium Deluxe - Volume II.iso / a / prog / asmsrc / rebelssource.lha / Sources / HAUSBAUN.PAS next >
Encoding:
Pascal/Delphi Source File  |  1994-07-09  |  2.9 KB  |  98 lines
  1.  
  2. (* Nice HausBauRoutine by Zulu & Grey of Rebels *)
  3.  
  4. Program DoItYourSelf_HausBau;
  5.  
  6. uses     graph,crt;
  7.  
  8. const    normalh=20;
  9.          normall=30;
  10.  
  11. var      x,y,zoom,newx,realzoom:integer;
  12.          treib,modus:integer;
  13.          maxx:word;
  14.  
  15. procedure House(x,y,zoom:integer;var newxpos:integer);
  16.  
  17.           var newh,newl,x1,x2,y1,y2,door:integer;
  18. begin
  19.          newh:=normalh*zoom;
  20.          newl:=normall*zoom;
  21.          door:=normalh div zoom;
  22.  
  23.          x1:=x;
  24.          y1:=y-newh;
  25.          x2:=x+newl;
  26.          y2:=y;
  27.  
  28.          if (x+newl)<maxx then begin
  29.  
  30.                                setfillstyle(1,15);
  31.                                bar(x1,y1,x2,y2);
  32.  
  33.                                x1:=x;
  34.                                y1:=y-newh;
  35.                                x2:=x+(newl DIV 2);
  36.                                y2:=y1-(newh div 2);
  37.  
  38.                                setcolor(4);
  39.                                setfillstyle(1,4);
  40.                                line(x1,y1,x2,y2);
  41.                                x1:=x1+newl;
  42.                                line(x2,y2,x1,y1);
  43.                                line(x,y-newh,x1,y1);
  44.                                floodfill(x1-(newl div 2),y1-(newh div 2)+4,4);
  45.  
  46.                                x1:=x+door+(newl div 6);
  47.                                y1:=y-(newh div 2);
  48.                                x2:=x1+(newl div 5);
  49.                                y2:=y;
  50.                                bar(x1,y1,x2,y2);
  51.  
  52.                                x2:=x+newl-door-(newl div 8);
  53.                                x1:=x+newl-door-(newl div 2);
  54.                                y1:=y-newh+(newh div 4);
  55.                                y2:=y1+(newh div 4);
  56.                                bar(x1,y1,x2,y2);
  57.  
  58.                                setcolor(15);
  59.                                setfillstyle(1,15);
  60.  
  61.                                circle(x+(newl div 2),y-newh-(newh div 4),zoom*2);
  62.                                floodfill(x+(newl div 2),y-newh-(newh div 4),15);
  63.  
  64.                                end;
  65.  
  66.          newxpos:=x+newl;
  67. end;
  68.  
  69. begin
  70.          clrscr;
  71.          writeln('Demoprogramm fuer einfachen Hausbau relativ zu einer Koordinate');
  72.          writeln;
  73.          write('Bitte geben Sie nun die X-Position des Punktes ein: ');readln(x);
  74.          write('Bitte geben Sie nun die Y-Position des Punktes ein: ');readln(y);
  75.          write('Bitte geben Sie nun den minimalen Zoomfaktor ein:   ');readln(zoom);
  76.  
  77.          randomize;
  78.  
  79.          treib:=detect;
  80.          initgraph(treib,modus,'c:\tp\bgi');
  81.  
  82.          maxx:=getmaxx;
  83.  
  84.          repeat
  85.                realzoom:=zoom+random(7);
  86.  
  87.                if realzoom>1 then begin
  88.                                   House(x,y,realzoom,newx);
  89.                                   x:=newx+2;
  90.                                   end;
  91.  
  92.          until newx>=maxx;
  93.  
  94.          readln;
  95.          closegraph;
  96. end.
  97.  
  98.